% sl lights out
% author: Nicky Nickell <nicky.nickell@gmail.com>

(setq *OUTPUT nil)

(de range (start end)
  (cond ((greaterp start end)
         (cond ((eqn start end) (cons end nil))
               (t (cons start (range (sub1 start) end)))))
        (t
         (cond ((eqn start end) (cons end nil))
               (t (cons start (range (add1 start) end)))))))

(de linkify (src &optional text)
  (dom-append (dom-create "a" (list (cons "href" src))) 
              (cond ((null text) src)
                    (t text))))

(de xor (a b)
  (or (and (not a) b)
      (and a (not b))))

(de coordinates-to-index (c r)
  (plus (times size c) r))

(de index-to-coordinates (i)
  (divide i size))

(de validate-coordinates (p)
  (prog (c r)
    (setq c (car p))
    (setq r (cadr p))
    (return (and (greaterp c -1)
                 (greaterp r -1)
                 (lessp c size)
                 (lessp r size)))))

(de make-board (s)
  (vector2list (make-vector (sub1 (times s s)) nil)))

(de make-solvable-board (steps)
  (prog (cboard)
    (setq cboard (make-board size))
    (mapc (range 0 (sub1 steps))
          (lambda (n)
            (setq cboard (toggle cboard moves (random size) (random size)))))
    (return cboard)))

(de make-moves (s)
  (mapcar (range 0 (sub1 (times s s)))
          (lambda (n)
            (prog (cboard p c r north south east west uplim)
              (setq cboard (make-board s))
              (setq p (index-to-coordinates n))
              (setq c (car p))
              (setq r (cdr p))
              (setq north (list (sub1 c) r))
              (setq south (list (add1 c) r))
              (setq east (list c (add1 r)))
              (setq west (list c (sub1 r)))
              (rplaca (pnth n cboard) t)
              (cond ((validate-coordinates north)
                     (rplaca (pnth (apply #'coordinates-to-index north) cboard) t)))
              (cond ((validate-coordinates south)
                     (rplaca (pnth (apply #'coordinates-to-index south) cboard) t)))
              (cond ((validate-coordinates east)
                     (rplaca (pnth (apply #'coordinates-to-index east) cboard) t)))
              (cond ((validate-coordinates west)
                     (rplaca (pnth (apply #'coordinates-to-index west) cboard) t)))
              (return cboard)))))

(de make-display (s)
  (prog (board)
    (setq board (dom-create "div"))
    (mapc (range 0 (sub1 s))
          (lambda (col)
            (progn (dom-append board "<br>")
                   (mapc (range 0 (sub1 s))
                         (lambda (row)
                           (dom-append board (dom-create-checkbox (list (cons "id" (coordinates-to-index col row)))
                                                                  (list (cons "onclick" (list "click-action" (coordinates-to-index col row)))))))))))
    (return board)))

(de update-display (b)
  (mapc (range 0 (sub1 (times size size)))
        (lambda (i)
          (prog (box val)
            (setq box (dom-get-element-by-id (to-string i)))
            (setq val (nth i b))
            (cond ((equal val t) (dom-set-attribute box "checked" t))
                  ((equal val nil) (dom-set-attribute box "checked" nil)))))))

(de toggle (b m c r)
  (mapcar (pair b (nth (coordinates-to-index c r) m))
          (lambda (p) (xor (car p) (cdr p)))))

(de click-action (i)
  (prog (p c r)
    (setq p (index-to-coordinates i))
    (setq c (car p))
    (setq r (cdr p))
    (setq board (toggle board moves c r))
    (update-display board)))

(de reset nil
  (prog (display)
    (setq board (make-board size))
    (setq moves (make-moves size))
    (setq display (dom-get-element-by-id "board"))
    (dom-clear display)
    (dom-append display (make-display size))
    (update-display board)))

(de new-board nil
  (progn (reset)
         (setq board (make-solvable-board difficulty))
         (update-display board)))

(de set-difficulty (d)
  (progn (setq difficulty d)
         (new-board)))

(de set-size (s)
  (progn (setq size s)
         (new-board)))

(setq body (dom-get-body))
(dom-set-title "sl lights out")
(dom-append body 
  "for a description of the game see "
  (linkify "http://en.wikipedia.org/wiki/Lights_Out_(game)" 
           "the wikipedia page.")
  (dom-create "div" '(("id" . "board")))
  (dom-create-button "clear" nil '(("onclick" . (reset))))
  (dom-create-button "new board" nil '(("onclick" . (new-board))))
  "<br>difficulty: "
  (dom-create-button "easy" nil '(("onclick" . (set-difficulty 2))))
  (dom-create-button "medium" nil '(("onclick" . (set-difficulty 4))))
  (dom-create-button "hard" nil '(("onclick" . (set-difficulty 6))))
  "<br>size: "
  (dom-create-button "3x3" nil '(("onclick" . (set-size 3))))
  (dom-create-button "4x4" nil '(("onclick" . (set-size 4))))
  (dom-create-button "5x5" nil '(("onclick" . (set-size 5))))
  (dom-create-button "6x6" nil '(("onclick" . (set-size 6)))))

(setq size 5)
(setq difficulty 4)
(new-board)
